home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / edit.tcl < prev    next >
Encoding:
Text File  |  1997-04-09  |  2.5 KB  |  80 lines
  1. ##############################################################################
  2. # $Id: edit.tcl,v 1.3 1997/04/09 13:13:01 stewart Exp $
  3. #
  4. # edit.tcl - procedures used in cut, copy, and paste
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:copy {} {
  26.     global vTcl
  27.     set vTcl(buffer) [vTcl:create_compound $vTcl(w,widget)]
  28.     set vTcl(buffer,type) [vTcl:lower_first $vTcl(w,class)]
  29. }
  30.  
  31. proc vTcl:cut {} {
  32.     global vTcl
  33.     if { $vTcl(w,widget) == "." } {
  34.         return
  35.     }
  36.     vTcl:destroy_handles
  37.     vTcl:copy
  38.     set parent [winfo parent $vTcl(w,widget)]
  39.     set do "destroy $vTcl(w,widget)"
  40.     set undo "vTcl:insert_compound $vTcl(w,widget) \{$vTcl(buffer)\} $vTcl(w,def_mgr)"
  41.     vTcl:push_action $do $undo
  42.     if { $vTcl(w,manager) == "wm" } {
  43.         vTcl:select_widget .
  44.         set vTcl(w,insert) .
  45.     } else {
  46.         vTcl:select_widget $parent
  47.         set vTcl(w,insert) $parent
  48.     }
  49. }
  50.  
  51. proc vTcl:delete {} {
  52.     global vTcl
  53.     if { $vTcl(w,widget) == "." } {
  54.         return
  55.     }
  56.     vTcl:destroy_handles
  57.     set parent [winfo parent $vTcl(w,widget)]
  58.     set buffer [vTcl:create_compound $vTcl(w,widget)]
  59.     set do "destroy $vTcl(w,widget)"
  60.     set undo "vTcl:insert_compound $vTcl(w,widget) \{$buffer\} $vTcl(w,def_mgr)"
  61.     vTcl:push_action $do $undo
  62.     vTcl:select_widget $parent
  63.     set vTcl(w,insert) $parent
  64. }
  65.  
  66. proc vTcl:paste {} {
  67.     global vTcl
  68.     if { $vTcl(buffer) != "" } {
  69.         set name [vTcl:new_widget_name $vTcl(buffer,type) $vTcl(w,insert)]
  70.         set do "
  71.             vTcl:insert_compound $name \{$vTcl(buffer)\} $vTcl(w,def_mgr)
  72.             vTcl:setup_bind_tree $name
  73.         "
  74.         set undo "destroy $name"
  75.         vTcl:push_action $do $undo
  76.         vTcl:active_widget $name
  77.     }
  78. }
  79.  
  80.